Este documento consiste en una revisión del proceso de validación de EPSOC 2018. Se trata de un documento reproducible y dinámico que será actualizado cada vez que haya una nueva entrega de datos durante el trabajo de campo. El código está inserto dentro del documento, pero replegado. Para verlo hacer click en cuadro code.
Se cargan los datos en el formato entregado y se homogeneiza el formato en minúscula y usando puntos (“.”) para separar en vez de guiones bajos (“_”).
pacman::p_load(tidyverse, lubridate, anytime, chron,
haven, sf,
sjlabelled, sjmisc,
validate, eeptools, kableExtra, janitor, here, naniar,
captioner)
if(Sys.info()[["user"]] == 'caayala'){
path <- "/Users/caayala/Dropbox (DESUC)/DESUC/Proyectos/3 Políticas Públicas/EPSOC 2018/BD/"
} else if(Sys.info()[["user"]] == 'Andres') {
path <- "/Users/Andres/Dropbox (DESUC)/Proyectos/3 Políticas Públicas/EPSOC 2018/BD/"
}
epsoc <-haven::read_spss(paste0(path, '190205 - EPSOC Base parcial 16.sav')) %>%
clean_names() %>%
mutate(region = folio %/% 100000,
i_1_orden = as.integer(i_1_orden))
names(epsoc) <- tolower(gsub("_", ".", names(epsoc)))
grabacion <- FALSE
kable_estilo <- function(tabla){
tabla %>%
kableExtra::kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
full_width=F)
}
makeVlist <- function(dta) {
labels <- sapply(dta, function(x) attr(x, "label"))
tibble(name = names(labels),
label = labels)
} ## Etiquetas variables
labs.epsoc <- makeVlist(epsoc)
labs.epsoc <- labs.epsoc %>%
mutate(label2 = map_chr(label, toString))
labs.epsoc <- get_label(epsoc)
La actual base cuenta con 818 casos recogidos entre el 2018-10-17 y el 2019-02-03.
epsoc %>%
count(region, status) %>%
spread(status, n) %>%
janitor::adorn_totals(where = c('row', 'col')) %>%
kable() %>%
kable_estilo()
| region | Aceptado | In Progress (Other) | Requires Approval | Total |
|---|---|---|---|---|
| 2 | 294 | 28 | 25 | 347 |
| 9 | 95 | 11 | 57 | 163 |
| 13 | 205 | 49 | 54 | 308 |
| Total | 594 | 88 | 136 | 818 |
epsoc <- epsoc %>%
mutate(rango_edad = rec(edad.seleccionado,
rec = "1:17 = 1[menor de 18 años];
18:24 = 2[18 a 24 años];
25:44 = 3[25 a 44 años];
45:59 = 4[45 a 59 años]"))
frq(epsoc, rango_edad)
##
## # rango_edad <numeric>
## # total N=818 valid N=815 mean=3.24 sd=0.71
##
## val label frq raw.prc valid.prc cum.prc
## 1 menor de 18 años 0 0.00 0.00 0.00
## 2 18 a 24 años 133 16.26 16.32 16.32
## 3 25 a 44 años 351 42.91 43.07 59.39
## 4 45 a 59 años 331 40.46 40.61 100.00
## NA NA 3 0.37 NA NA
epsoc %>%
filter(is.na(rango_edad)) %>%
select(sexo.seleccionado, edad.seleccionado, situacion.laboral.seleccionado)
## # A tibble: 3 x 3
## sexo.seleccionado edad.seleccionado situacion.laboral.seleccionado
## <dbl+lbl> <dbl> <dbl+lbl>
## 1 NA NA NA
## 2 NA NA NA
## 3 NA NA NA
Probablemente discrepancia de edad para las personas mayores de 59 años se debe a una confusión entre edad reportada o fecha de cumpleaños. Podría también tratarse de casos que tenían 59 años al momento de hacerse la encuesta, pero que al momento de validar los datos ya hayan cumplido los 60 .Quedarán asignados al grupo de edad rango_edad == 4.
epsoc <- epsoc %>%
mutate(rango_edad = replace(rango_edad, edad.seleccionado %in% c(60, 61), 4))
epsoc %>%
count(sexo.seleccionado, rango_edad, situacion.laboral.seleccionado) %>%
mutate_all(as_label) %>%
mutate(prop = round(n/sum(n), 4)) %>%
kable() %>%
kable_estilo()
| sexo.seleccionado | rango_edad | situacion.laboral.seleccionado | n | prop |
|---|---|---|---|---|
| Hombre | 18 a 24 años | Trabaja | 28 | 0.0342 |
| Hombre | 18 a 24 años | No trabaja | 36 | 0.0440 |
| Hombre | 25 a 44 años | Trabaja | 118 | 0.1443 |
| Hombre | 25 a 44 años | No trabaja | 12 | 0.0147 |
| Hombre | 45 a 59 años | Trabaja | 92 | 0.1125 |
| Hombre | 45 a 59 años | No trabaja | 20 | 0.0244 |
| Mujer | 18 a 24 años | Trabaja | 21 | 0.0257 |
| Mujer | 18 a 24 años | No trabaja | 48 | 0.0587 |
| Mujer | 25 a 44 años | Trabaja | 137 | 0.1675 |
| Mujer | 25 a 44 años | No trabaja | 84 | 0.1027 |
| Mujer | 45 a 59 años | Trabaja | 115 | 0.1406 |
| Mujer | 45 a 59 años | No trabaja | 104 | 0.1271 |
| NA | NA | NA | 3 | 0.0037 |
La distribución de la duración de las entrevistas registrada por las tablets se puede ver en la siguiente figura.
homologar_fechas <- function(fecha){
fecha %>%
str_replace_all(c("^\\D{3} " = "", '(.*)(\\d{4}$)' = '\\2 \\1')) %>%
anytime::anytime()
}
epsoc <- epsoc %>%
mutate_at(vars(starts_with('time')), homologar_fechas)
epsoc <- epsoc %>%
mutate(duration = str_replace_all(duration, c('-' = '', '^(\\d{2})' = '0\\.\\1'))) %>%
separate(duration, into = c('dura.d', 'duracion'), sep = '\\.', convert = TRUE, remove = FALSE) %>%
mutate(duracion.t = as.duration(hms(duracion) + hms(hms::hms(hour = (24 * dura.d)))))
epsoc$duracion.t.min <- epsoc$duracion.t@.Data/60
epsoc %>%
ggplot(aes(x = duracion.t.min)) +
geom_histogram(binwidth = 5) +
theme_bw() +
ggtitle("Distribución duración entrevistas por región (escala truncada < 150 minutos)") +
labs(x = "Duración total entrevista (minutos)",
y = "Frecuencia") +
coord_cartesian(xlim = 0:150) +
scale_x_continuous(breaks = seq(0, 150, by = 15)) +
facet_grid(as_factor(region) ~ .)
Existen 40 entrevistas que duran menos de 20 minutos, estas debieran ser supervisadas.
epsoc %>%
filter(as.double(duracion.t.min) < 20) %>%
select(folio, duracion.t.min) %>%
knitr::kable(col.names = c("Folio", "Duración (minutos)"),
caption = "Entrevistas de menos de 20 minutos",
digits = 1) %>%
kable_estilo() %>%
column_spec(1, width = "10em") %>%
column_spec(2, width = "10em")
| Folio | Duración (minutos) |
|---|---|
| 200329 | 19.8 |
| 201186 | 18.2 |
| 201293 | 19.7 |
| 201350 | 11.4 |
| 201434 | 19.9 |
| 201863 | 16.0 |
| 201921 | 16.4 |
| 201947 | 19.1 |
| 202382 | 19.4 |
| 202465 | 19.6 |
| 202879 | 16.4 |
| 202895 | 19.3 |
| 203190 | 18.7 |
| 203372 | 18.4 |
| 204065 | 19.0 |
| 204396 | 19.5 |
| 204867 | 16.4 |
| 204966 | 18.6 |
| 205039 | 17.2 |
| 205443 | 19.4 |
| 205484 | 16.6 |
| 207431 | 16.9 |
| 207456 | 19.4 |
| 207464 | 14.2 |
| 208462 | 19.8 |
| 902296 | 17.6 |
| 902312 | 19.2 |
| 902940 | 17.9 |
| 903013 | 19.3 |
| 903088 | 20.0 |
Existen 43 entrevistas que duran más de 150 minutos, estas debieran ser supervisadas.
epsoc %>%
filter(as.double(duracion.t.min) > 150) %>%
transmute(folio, duracion.t.min / 60) %>%
knitr::kable(col.names = c("Folio", "Duración (horas)"),
caption = "Entrevistas de más de 150 minutos",
digits = 1) %>%
kable_estilo() %>%
column_spec(1, width = "10em") %>%
column_spec(2, width = "10em")
| Folio | Duración (horas) |
|---|---|
| 200444 | 72.8 |
| 200527 | 69.8 |
| 200550 | 4.6 |
| 200717 | 49.6 |
| 202135 | 71.9 |
| 202671 | 25.7 |
| 203349 | 3.4 |
| 205427 | 14.2 |
| 900183 | 2.6 |
| 902569 | 2.7 |
| 903443 | 235.0 |
| 903815 | 236.7 |
| 903922 | 91.3 |
| 903963 | 120.9 |
| 905976 | 14.3 |
| 1301928 | 18.6 |
| 1301951 | 192.9 |
| 1302157 | 4.2 |
| 1302421 | 96.4 |
| 1303254 | 25.1 |
| 1303262 | 25.6 |
| 1303643 | 24.6 |
| 1303833 | 4.0 |
| 1304062 | 23.6 |
| 1304732 | 24.4 |
| 1305465 | 23.4 |
| 1305515 | 72.0 |
| 1306646 | 2.8 |
| 1307339 | 218.9 |
| 1307370 | 50.1 |
| 1310515 | 22.6 |
| 1311471 | 5.2 |
| 1312958 | 50.4 |
Cantidad de encuestas realizadas por día.
## Comienzo encuesta
epsoc$time1.hms <- hms::as.hms(epsoc$time1)
epsoc$time1.wday <- lubridate::wday(epsoc$time1)
epsoc$time1.dmy <- date(epsoc$time1)
epsoc %>%
count(time1.dmy) %>%
mutate(n_mean = mean(n)) %>%
ggplot(aes(x = time1.dmy, y = n)) +
geom_line() +
geom_smooth() +
geom_hline(aes(yintercept = n_mean), colour = 'green') +
geom_label(aes(x = min(time1.dmy)[[1]], y = n_mean[[1]], label = round(n_mean, 1))) +
labs(title = 'Número de encuestas por día') +
scale_x_date(breaks = '2 weeks')
## `geom_smooth()` using method = 'loess' and formula 'y ~ x'
epsoc %>%
count(time1.wday) %>%
mutate(n_mean = mean(n)) %>%
ggplot(aes(x = time1.wday, y = n)) +
geom_line() +
geom_smooth() +
geom_hline(aes(yintercept = n_mean), colour = 'green') +
geom_label(aes(x = min(time1.wday)[[1]], y = n_mean[[1]], label = round(n_mean, 1))) +
labs(title = 'Número de encuestas por día de la semana') +
scale_x_continuous(breaks = seq(7))
## `geom_smooth()` using method = 'loess' and formula 'y ~ x'
Existen 186 entrevistas sin datos de georreferenciación:
epsoc %>%
select(folio, latitude, srvyr) %>%
group_by(srvyr) %>%
mutate(n.enc = length(folio)) %>%
filter(is.na(latitude)) %>%
select(folio, srvyr, n.enc) %>%
mutate(n.enc.sg = (length(folio)/n.enc)*100) %>%
arrange(srvyr, folio) %>%
group_by_at(vars(-folio)) %>%
nest() %>%
mutate(Folio = map_chr(data, ~ flatten(.) %>% str_c(., collapse = ', '))) %>%
select(-data) %>%
kable(digits = 1,
col.names = c("Encuestador", "Total encuestas", "% sin georef.", "folios")) %>%
kable_estilo()
| Encuestador | Total encuestas | % sin georef. | folios |
|---|---|---|---|
| ageraldo.2 | 63 | 39.7 | 200857, 201376, 201475, 201715, 202143, 202465, 202598, 202770, 203034, 203042, 203083, 203216, 203224, 203240, 203315, 203331, 203570, 203877, 203885, 204040, 204081, 204289, 204297, 205237, 205427 |
| atoledo.9 | 103 | 1.0 | 906164 |
| cobando.9 | 26 | 23.1 | 903344, 903443, 903450, 903625, 903658, 906438 |
| i.perez | 23 | 30.4 | 1300433, 1301514, 1302850, 1312610, 1312636, 1312644, 1312669 |
| j.morales | 11 | 9.1 | 1305465 |
| jossio.2 | 98 | 49.0 | 200253, 200493, 200691, 201038, 201053, 201186, 201293, 201392, 201491, 201590, 201749, 201863, 202192, 202226, 202242, 202267, 202382, 202481, 202796, 202879, 202895, 203059, 203067, 203075, 203141, 203190, 203489, 203588, 203752, 203760, 203794, 203844, 203851, 204396, 204644, 204867, 204966, 205039, 205062, 205484, 205658, 205682, 205872, 206144, 206177, 206763, 207233, 207266 |
| ksakuda.2 | 29 | 48.3 | 201483, 201921, 202473, 202788, 203323, 203372, 203380, 204016, 207415, 207423, 207431, 207449, 207456, 207464 |
| M.Alert | 5 | 100.0 | 1305234, 1305242, 1306646, 1310515, 1311471 |
| m.calderon | 2 | 100.0 | 1310226, 1311935 |
| mdiaz.2 | 83 | 7.2 | 202697, 203117, 203257, 203265, 203273, 205229 |
| mrobles.2 | 58 | 51.7 | 200212, 200477, 201111, 201772, 202218, 202234, 202275, 202572, 204339, 204818, 204875, 205013, 205047, 205450, 205468, 205666, 205690, 205864, 205948, 205963, 206110, 206151, 206318, 206623, 206631, 206714, 207647, 207712, 207936, 208314 |
| ncaceres.2 | 1 | 100.0 | 205930 |
| nicol.alarcon | 3 | 100.0 | 1310119, 1310143, 1310150 |
| p.aguilera | 4 | 75.0 | 1300912, 1300953, 1303726 |
| p.gajardo | 6 | 33.3 | 1303510, 1303528 |
| p.vegazo | 96 | 6.2 | 1300870, 1303825, 1304542, 1309129, 1309160, 1309178 |
| rfigueroa.9 | 8 | 100.0 | 901918, 901926, 902023, 902056, 902072, 905919, 905943, 905950 |
| s.gonzalez | 16 | 75.0 | 1301910, 1301928, 1301936, 1301944, 1301951, 1301969, 1302066, 1303916, 1303940, 1303965, 1305911, 1307057 |
| v.becerra | 2 | 100.0 | 1300672, 1300698 |
| v.sierra | 55 | 3.6 | 1306679, 1306695 |
| ycifuente.9 | 4 | 50.0 | 901314, 901322 |
epsoc_geo <- epsoc %>%
select(folio, sbj.num, region, srvyr, longitude, latitude) %>%
filter(!is.na(latitude)) %>%
sf::st_as_sf(coords = c('longitude', 'latitude'),
crs = "+proj=longlat +ellps=GRS80")
sf::write_sf(epsoc_geo,
here::here('validacion_epsoc_puntos_respuesta.kml'),
dataset_options=c("NameField=folio"),
delete_dsn=TRUE)
epsoc_geo %>%
filter(region == 2) %>%
ggplot(aes(color = srvyr)) +
geom_sf()
epsoc_geo %>%
filter(region == 9) %>%
ggplot(aes(color = srvyr)) +
geom_sf()
epsoc_geo %>%
filter(region == 13) %>%
ggplot(aes(color = srvyr)) +
geom_sf()
EPSOC contiene dos experimentos que constituyen un foco de análisis del instrumento. El primer experimento consiste en un diseño factorial a través viñetas. El segundo se trata de una aleatorización del orden de preguntas sobre recompensa percibida y justa para tres objetos de evaluación: un obrero, un presidente de empresa y el respondente. Actualmente no es posible validar estos experimento por falta de información.
Para validar el proceso con las viñetas necesitamos:
Revisar la distribución efectiva captada de los decks de viñetas en terreno hasta el momento.
epsoc %>%
select(folio, i.1.grupo) %>%
head()
## # A tibble: 6 x 2
## folio i.1.grupo
## <dbl> <chr>
## 1 200139 23
## 2 200147 17
## 3 200162 11
## 4 200212 15
## 5 200220 15
## 6 200238 31
epsoc %>%
transmute(i.1.grupo = as.integer(i.1.grupo),
region) %>%
group_by_all() %>%
count() %>%
group_by(region) %>%
mutate(n_mean = mean(n)) %>%
ggplot(aes(x = as_factor(i.1.grupo), y = n)) +
geom_col() +
geom_hline(aes(group = region, yintercept = n_mean), colour = 'green') +
geom_text(aes(label = ..y..), nudge_y = 1, size = 3) +
facet_grid(rows = vars(region)) +
labs(title = 'Distribución de viñetas')
time2 y time3 no siguen un formato homogéneo para registrar la hora. Por ejemplo, en algún caso se utiliza el formato “2018-10-27T19:05:08-03:00” y en otros “Fri Oct 19 13:01:59 -0300 2018”## Comienzo viñetas
epsoc$time2.hms <- hms::as.hms(epsoc$time2)
epsoc$time2.dmy <- date(epsoc$time2)
## Fin viñetas
epsoc$time3.hms <- hms::as.hms(epsoc$time3)
epsoc$time3.dmy <- date(epsoc$time3)
epsoc$dura.vinetas <- difftime(epsoc$time3, epsoc$time2,
units = "mins")
ggplot(epsoc, aes(x = time2.dmy, y = time2.hms)) +
geom_point(alpha = 0.6) +
labs(x = "Día", y = "Hora") +
ggtitle("Día y hora comienzo actividad viñetas") +
theme_bw()
ggplot(epsoc, aes(x = srvyr, y = time2.hms)) +
geom_point(alpha = 0.6) +
labs(x = "Encuestador", y = "Hora") +
ggtitle("Hora comienzo actividad viñetas según encuestador") +
theme_minimal() +
theme(axis.text.x = element_text(angle = 90, vjust = .5, hjust = 1))
epsoc %>%
mutate(vin.cort = ifelse(dura.vinetas < 5, "< 5'", ">= 5'")) %>%
ggplot(aes(dura.vinetas)) +
geom_histogram(aes(fill = vin.cort)) + theme_bw() +
theme(legend.title=element_blank()) +
ggtitle("Duración ejercicio viñetas") +
xlab("Minutos")
Como se puede ver en la figura anterior, la distribución del tiempo de duración del ejercicio de viñetas es variable. En términos de validación, llama la atención que se logre realizar el ejercicio en menos de cinco minutos. Estos casos deberían ser revisados apenas sea posible.
ggplot(epsoc, aes(x = srvyr, y = if_else(dura.vinetas < 60, dura.vinetas, 60),
colour = status)) +
geom_point(alpha = 0.5,
position = position_jitter(width = .2)) +
scale_color_manual(values = c('green', 'orange', 'blue')) +
facet_grid(cols = vars(region), scales = 'free_x', space = 'free_x') +
labs(x = "Encuestador", y = "minutos") +
ggtitle("Duración de actividad viñetas según encuestador según región") +
theme_minimal() +
theme(axis.text.x = element_text(angle = 90, vjust = .5, hjust = 1))
## Don't know how to automatically pick scale for object of type difftime. Defaulting to continuous.
En particular, deben supervisarse las siguientes entrevistas donde el ejercicio duró menos de 5 minutos:
kable(epsoc %>%
group_by(srvyr) %>%
mutate(n.enc = length(folio)) %>%
select(folio, dura.vinetas, srvyr, n.enc) %>%
filter(dura.vinetas <= 5) %>%
mutate(n.enc.cort = (length(folio)/n.enc)*100) %>%
arrange(srvyr, dura.vinetas),
digits = 1,
col.names = c("Folio", "Duración viñetas", "Encuestador", "Total encuestas", "% cortas"),
caption = "Ejercicio viñetas de menos de 5 minutos") %>%
kable_estilo() #%>%
| Folio | Duración viñetas | Encuestador | Total encuestas | % cortas |
|---|---|---|---|---|
| 205427 | 2.6 mins | ageraldo.2 | 63 | 3.2 |
| 202465 | 5.0 mins | ageraldo.2 | 63 | 3.2 |
| 902296 | 4.4 mins | atoledo.9 | 103 | 1.0 |
| 902254 | 4.1 mins | cobando.9 | 26 | 3.8 |
| 204966 | 4.3 mins | jossio.2 | 98 | 3.1 |
| 204396 | 4.6 mins | jossio.2 | 98 | 3.1 |
| 201186 | 4.7 mins | jossio.2 | 98 | 3.1 |
| 1310119 | 3.2 mins | nicol.alarcon | 3 | 33.3 |
| 905943 | 4.9 mins | rfigueroa.9 | 8 | 12.5 |
#column_spec(1, width = "10em") %>%
#column_spec(2, width = "10em") %>%
#column_spec(3, width = "10em")
labels_correcion <- function(.vect) {
replace(.vect, .vect == 6, -1) %>%
remove_labels(labels = '- 1') %>%
add_labels(labels = c('- 1' = -1))
}
gg_ideologia_orden <- function(.data, var_orden, miss = 88){
var_orden_quo <- enquo(var_orden)
.data %>%
gather('variable', 'valor', -!!var_orden_quo) %>%
filter(valor < miss) %>%
ggplot(aes(x = valor)) +
geom_bar() +
facet_grid(rows = vars(variable),
cols = vars(!!var_orden_quo))
}
ideologia_ego <- list(orden1 = c("c0.1", "c1.1.1", "c1.2.1", "c1.3.1", "c1.4.1", "c2.1.1", "c2.2.1", "c2.3.1", "c2.4.1"),
orden2 = c("c0.2", "c1.4.2", "c1.1.2", "c1.2.2", "c1.3.2", "c2.4.2", "c2.1.2", "c2.2.2", "c2.3.2"),
orden3 = c("c0.3", "c1.3.3", "c1.4.3", "c1.1.3", "c1.2.3", "c2.3.3", "c2.4.3", "c2.1.3", "c2.2.3"),
orden4 = c("c0.4", "c1.2.4", "c1.3.4", "c1.4.4", "c1.1.4", "c2.2.4", "c2.3.4", "c2.4.4", "c2.1.4"))
df_ideologia_ego <- epsoc %>%
select(folio, i.1.orden, !!!flatten_chr(ideologia_ego)) %>%
nest(-i.1.orden) %>%
arrange(i.1.orden)
df_ideologia_ego <- df_ideologia_ego %>%
mutate(orden = ideologia_ego[str_glue("orden{i.1.orden + 1}")],
data = map2(data, orden, ~select(.x, one_of("folio", .y))),
data_var = map(data, names) %>% map_chr(str_c, collapse = ', '))
df_ideologia_ego
## # A tibble: 4 x 4
## i.1.orden data orden data_var
## <int> <list> <list> <chr>
## 1 0 <tibble [191… <chr [… folio, c0.1, c1.1.1, c1.2.1, c1.3.1, c1.…
## 2 1 <tibble [206… <chr [… folio, c0.2, c1.4.2, c1.1.2, c1.2.2, c1.…
## 3 2 <tibble [208… <chr [… folio, c0.3, c1.3.3, c1.4.3, c1.1.3, c1.…
## 4 3 <tibble [213… <chr [… folio, c0.4, c1.2.4, c1.3.4, c1.4.4, c1.…
map_dfc(df_ideologia_ego$data, get_label) %>%
mutate_all(str_trunc, width = 25)
## # A tibble: 10 x 4
## V1 V2 V3 V4
## <chr> <chr> <chr> <chr>
## 1 "" "" "" ""
## 2 Observe esta esca… Observe esta esc… Observe esta esc… Observe esta esc…
## 3 "Escala \"Las fam… "Escala \"Las fa… "Escala \"Las fa… "Escala \"Las fa…
## 4 "Escala \"Chile n… "Escala \"Chile … "Escala \"Chile … "Escala \"Chile …
## 5 "Escala \"Educaci… "Escala \"Educac… "Escala \"Educac… "Escala \"Educac…
## 6 "Escala \"Más con… "Escala \"Más co… "Escala \"Más co… "Escala \"Más co…
## 7 "Escala \"Las fam… "Escala \"Las fa… "Escala \"Las fa… "Escala \"Las fa…
## 8 "Escala \"Chile n… "Escala \"Chile … "Escala \"Chile … "Escala \"Chile …
## 9 "Escala \"Educaci… "Escala \"Educac… "Escala \"Educac… "Escala \"Educac…
## 10 "Escala \"Más con… "Escala \"Más co… "Escala \"Más co… "Escala \"Más co…
suppressWarnings(
df_ideologia_ego <- df_ideologia_ego %>%
mutate(data = map(data, ~rename_all(.x, ~c("folio", str_remove(ideologia_ego$orden1,'.\\d{1,2}$'))))) %>%
select(data) %>%
unnest()
)
df_ideologia_ego <- copy_labels(df_new = df_ideologia_ego,
df_origin = epsoc %>%
select(one_of(c('folio', ideologia_ego$orden1))) %>%
rename_all(~c("folio", str_remove(ideologia_ego$orden1,'.\\d{1,2}$'))))
Agregar variables reconstruidas a base de datos.
epsoc <- left_join(epsoc,
df_ideologia_ego,
by = 'folio')
## Warning: Column `folio` has different attributes on LHS and RHS of join
epsoc %>%
select(i.1.orden, matches("c[1-2].\\d{1}$")) %>%
gather('variable', 'valor', -i.1.orden) %>%
mutate(referencia = if_else(str_detect(variable, 'c1.*'), 'ego', 'alter'),
outcome = str_extract(variable, '(\\d*)$')) %>%
filter(valor < 88) %>%
ggplot(aes(x = valor, fill = fct_rev(referencia))) +
geom_bar(position = position_dodge()) +
facet_grid(rows = vars(outcome),
cols = vars(i.1.orden)) +
labs(title = 'Distribución de viñetas ego y alter, según orden de preguntas') +
scale_fill_discrete(name = 'Referencia')
## Warning: attributes are not identical across measure variables;
## they will be dropped
Primero es necesario reunir las variables
ideologia_vin <- list(orden1 = c(1, 2, 3, 4),
orden2 = c(4, 1, 2, 3),
orden3 = c(3, 4, 1, 2),
orden4 = c(2, 3, 4, 1))
df_ideologia_vin <- epsoc %>%
select(folio, i.1.orden, matches("^c([3-9]|10)\\.[1-4].*")) %>%
nest(-i.1.orden) %>%
arrange(i.1.orden)
ideologia_variables <- function(persona, orden, grupo){
expand.grid(persona, orden, grupo) %>%
arrange(Var1) %>%
str_glue_data("c{Var1}.{Var2}.{Var3}")
}
df_ideologia_vin <- df_ideologia_vin %>%
mutate(orden = ideologia_vin[str_glue("orden{i.1.orden + 1}")],
variables = map2(orden, i.1.orden + 1, ~ideologia_variables(3:10, .x, .y)),
data = map2(data, variables, ~select(.x, one_of("folio", .y))),
data_var = map(data, names) %>% map_chr(str_c, collapse = ', '))
df_ideologia_vin %>%
select(i.1.orden, data_var)
## # A tibble: 4 x 2
## i.1.orden data_var
## <int> <chr>
## 1 0 folio, c3.1.1, c3.2.1, c3.3.1, c3.4.1, c4.1.1, c4.2.1, c4.3.1,…
## 2 1 folio, c3.4.2, c3.1.2, c3.2.2, c3.3.2, c4.4.2, c4.1.2, c4.2.2,…
## 3 2 folio, c3.3.3, c3.4.3, c3.1.3, c3.2.3, c4.3.3, c4.4.3, c4.1.3,…
## 4 3 folio, c3.2.4, c3.3.4, c3.4.4, c3.1.4, c4.2.4, c4.3.4, c4.4.4,…
etiquetas <- map(df_ideologia_vin$data, get_labels)
ideologia_vin1_names <- names(df_ideologia_vin$data[[1]])
ideologia_vin1_gen_names <- str_remove(ideologia_vin1_names, '.\\d{1,2}$')
suppressWarnings(
df_ideologia_vin <- df_ideologia_vin %>%
mutate(data = map(data, ~rename_all(.x, ~ideologia_vin1_gen_names))) %>%
select(data) %>%
unnest()
)
df_ideologia_vin <- copy_labels(df_new = df_ideologia_vin,
df_origin = epsoc %>%
select(!!!ideologia_vin1_names) %>%
rename_all(~ideologia_vin1_gen_names))
head(df_ideologia_vin)
## # A tibble: 6 x 33
## folio c3.1 c3.2 c3.3 c3.4 c4.1 c4.2 c4.3 c4.4 c5.1 c5.2 c5.3
## <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 200162 1 1 11 1 1 1 11 1 11 1 1
## 2 200238 11 10 1 2 2 1 11 11 3 3 10
## 3 200246 11 1 11 1 1 11 11 11 11 1 1
## 4 200329 4 11 10 3 4 9 3 3 8 3 10
## 5 200337 2 2 1 1 6 10 1 1 1 9 3
## 6 200410 1 1 1 1 11 11 1 1 11 11 1
## # … with 21 more variables: c5.4 <dbl>, c6.1 <dbl>, c6.2 <dbl>,
## # c6.3 <dbl>, c6.4 <dbl>, c7.1 <dbl>, c7.2 <dbl>, c7.3 <dbl>,
## # c7.4 <dbl>, c8.1 <dbl>, c8.2 <dbl>, c8.3 <dbl>, c8.4 <dbl>,
## # c9.1 <dbl>, c9.2 <dbl>, c9.3 <dbl>, c9.4 <dbl>, c10.1 <dbl>,
## # c10.2 <dbl>, c10.3 <dbl>, c10.4 <dbl>
Agregar variables reconstruidas a base de datos.
epsoc <- left_join(epsoc,
df_ideologia_vin,
by = 'folio')
## Warning: Column `folio` has different attributes on LHS and RHS of join
Gráficos para comparar distribuciones entre viñetas y orden
epsoc %>%
select(i.1.orden, matches('c([3-9]|10).1$')) %>%
gg_ideologia_orden(i.1.orden) +
labs(title = 'Distribución de viñetas Familias, según orden de preguntas')
## Warning: attributes are not identical across measure variables;
## they will be dropped
epsoc %>%
select(i.1.orden, matches('c([3-9]|10).2$')) %>%
gg_ideologia_orden(i.1.orden) +
labs(title = 'Distribución de viñetas Orden o Cambio, según orden de preguntas')
## Warning: attributes are not identical across measure variables;
## they will be dropped
epsoc %>%
select(i.1.orden, matches('c([3-9]|10).3$')) %>%
gg_ideologia_orden(i.1.orden) +
labs(title = 'Distribución de viñetas Educación, según orden de preguntas')
## Warning: attributes are not identical across measure variables;
## they will be dropped
epsoc %>%
select(i.1.orden, matches('c([3-9]|10).4$')) %>%
gg_ideologia_orden(i.1.orden) +
labs(title = 'Distribución de viñetas Grandes Empresas, según orden de preguntas')
## Warning: attributes are not identical across measure variables;
## they will be dropped
Para validar el experimento de evaluación de justicia necesitamos: - Una breve explicación de cómo están codificados los items de recompensa percibida y recompensa justa para un obrero, el presidente de una empresa y el respondente - Es fundamental saber cuál es la variable que define el orden en que se presentó una y otra pregunta
La variable a que determina el tratamiento mostrado en la encuesta es la variable num.grupo.jd.
flat_table(epsoc, num.grupo.jd, region, margin = 'col')
## region 2 9 13
## num.grupo.jd
## 0 26.80 23.31 22.73
## 1 23.63 27.61 25.32
## 2 27.95 21.47 26.62
## 3 21.61 27.61 25.32
Existen 24 variables asociadas al experimiento de recompensa justa que se detallan a continuación:
var_rec_justa <- find_var(epsoc, pattern = stringr::regex('obrero|pdte'), search = 'label')
var_rec_justa$var.label %>%
str_replace_all(c('Quisiéramos saber cuánto dinero cree Ud. que ganan las personas al mes en estos trabajos u ocupaciones que se mencionan más adelante, después de considerar los descuentos de salud, previsión u otros impuestos' = 'cuánto dinero cree Ud. que ganan',
'Pensando en lo que Ud. cree que las personas en estos trabajos deberían ganar al mes, después de los descuentos de salud, previsión u otros impuestos. ' = '')) %>%
paste0(var_rec_justa$var.name, " - ", sort(rep(seq(6), 4)), " - ", .)
## [1] "i.1.g1a.1.rec - 1 - cuánto dinero cree Ud. que ganan (pdte empresa)"
## [2] "i.2.g1a.1.rec - 1 - cuánto dinero cree Ud. que ganan (obrero)"
## [3] "i.1.g2a.1.rec - 1 - ¿Cuál sería una remuneración justa para (pdte empresa)?"
## [4] "i.2.g2a.1.rec - 1 - ¿Cuál sería una remuneración justa para (obrero)?"
## [5] "i.1.g2a.2.rec - 2 - ¿Cuál sería una remuneración justa para (pdte empresa)?"
## [6] "i.2.g2a.2.rec - 2 - ¿Cuál sería una remuneración justa para (obrero)?"
## [7] "i.1.g1a.2.rec - 2 - cuánto dinero cree Ud. que ganan (pdte empresa)"
## [8] "i.2.g1a.2.rec - 2 - cuánto dinero cree Ud. que ganan (obrero)"
## [9] "i.1.g1a.3.rec - 3 - cuánto dinero cree Ud. que ganan (pdte empresa)"
## [10] "i.2.g1a.3.rec - 3 - cuánto dinero cree Ud. que ganan (obrero)"
## [11] "i.1.g2b.3.rec - 3 - ¿Cuál sería una remuneración justa para (pdte empresa)?"
## [12] "i.2.g2b.3.rec - 3 - ¿Cuál sería una remuneración justa para (obrero)?"
## [13] "i.1.g1b.4.rec - 4 - ¿Cuál sería una remuneración justa para (pdte empresa)?"
## [14] "i.2.g1b.4.rec - 4 - ¿Cuál sería una remuneración justa para (obrero)?"
## [15] "i.1.g1a.4.rec - 4 - cuánto dinero cree Ud. que ganan (pdte empresa)"
## [16] "i.2.g1a.4.rec - 4 - cuánto dinero cree Ud. que ganan (obrero)"
## [17] "i.1.g1a.3.2 - 5 - (un obrero no calificado de una fábrica) Quisiéramos saber cuánto dinero cree Ud. que ganan las personas al mes en estos trabajos/ocupaciones que se mencionan más adelante, después de considerar los descuentos de salud, previsión u otros impuestos (i"
## [18] "i.1.g1b.3.2 - 5 - (un obrero no calificado de una fábrica) Pensando en lo que Ud. cree que sería justo que las personas en estos trabajos deberían ganar al mes, después de los descuentos de salud, previsión u otros impuestos (ingreso líquido). ¿Cuál sería una remu"
## [19] "i.1.g2b.4.2 - 5 - (un obrero no calificado de una fábrica) Pensando en lo que Ud. cree que sería justo que las personas en estos trabajos deberían ganar al mes, después de los descuentos de salud, previsión u otros impuestos (ingreso líquido). ¿Cuál sería una remu"
## [20] "i.1.g2a.4.2 - 5 - (un obrero no calificado de una fábrica) Quisiéramos saber cuánto dinero cree Ud. que ganan las personas al mes en estos trabajos/ocupaciones que se mencionan más adelante, después de considerar los descuentos de salud, previsión u otros impuestos (i"
## [21] "i.1.g1a.1.rec - 6 - cuánto dinero cree Ud. que ganan (pdte empresa)"
## [22] "i.2.g1a.1.rec - 6 - cuánto dinero cree Ud. que ganan (obrero)"
## [23] "i.1.g2a.1.rec - 6 - ¿Cuál sería una remuneración justa para (pdte empresa)?"
## [24] "i.2.g2a.1.rec - 6 - ¿Cuál sería una remuneración justa para (obrero)?"
Al inicio de la aplicación del cuestionario se implementó 4 grupos (del grupo 1 al 4 o variables i.1.g1a.1.rec a i.2.g1a.4.rec). Como puede verse el grupo 3 es identico al 1 y el grupo 4 es igual al 2 porque se mantuvo el orden de presidente empresa y luego obrero.
Para solucionarlo, se agregaron los grupos 5 y 6 en donde se se cambia el orden a obrero y luego presidente empresa. Con esto los 4 grupos (1, 2, 5 y 6) a los que cada persona se verá confrontada serán diferentes. Como se puede ver en el gráfico , la implementación del cambio se efectuó correctamente.
epsoc %>%
arrange(num.grupo.jd, time1) %>%
select(one_of(var_rec_justa$var.name)) %>%
naniar::vis_miss() +
labs(title = 'Distribución de respuestas en preguntas de recompensa justa') +
theme(axis.text.x = element_text(angle = 90, vjust = .5, hjust = 0))
La encuesta considera una serie de preguntas con escalas predefinidas. A continuación se revisa que los ítems sobre justicia tengan respuestas en el rango de 1 a 5 o bien valores de 8 o 9.
item_just <- find_var(epsoc, "usto")
item_just$var.name
## [1] "i.6.a1" "i.8.a1" "i.9.a1" "i.10.a1" "i.11.a1"
## [6] "i.12.a1" "i.13.a1" "i.16.a1" "i.1.g1b.3.2" "i.2.g1b.3.2"
## [11] "i.1.g2b.4.2" "i.2.g2b.4.2" "i.1.h1" "i.2.h1" "i.5.h1"
## [16] "i.7.h1" "i.8.h1" "i.10.h1" "i.11.h1" "i.12.h1"
## [21] "i.14.h1"
v <- validator(j := var_group(i.6.a1, i.8.a1, i.9.a1, i.10.a1, i.11.a1, i.12.a1, i.13.a1, i.16.a1,
i.1.h1, i.2.h1, i.5.h1, i.7.h1, i.8.h1, i.10.h1, i.11.h1, i.12.h1, i.14.h1),
j >= 1,
j <= 9,
j != 6,
j != 7)
cf2 <- confront(epsoc, v)
s.cf2 <- summary(cf2)
knitr::kable(s.cf2) %>%
kable_estilo()
| name | items | passes | fails | nNA | error | warning | expression |
|---|---|---|---|---|---|---|---|
| V2.1 | 818 | 818 | 0 | 0 | FALSE | FALSE | (i.6.a1 - 1) >= -1e-08 |
| V2.2 | 818 | 818 | 0 | 0 | FALSE | FALSE | (i.8.a1 - 1) >= -1e-08 |
| V2.3 | 818 | 818 | 0 | 0 | FALSE | FALSE | (i.9.a1 - 1) >= -1e-08 |
| V2.4 | 818 | 818 | 0 | 0 | FALSE | FALSE | (i.10.a1 - 1) >= -1e-08 |
| V2.5 | 818 | 818 | 0 | 0 | FALSE | FALSE | (i.11.a1 - 1) >= -1e-08 |
| V2.6 | 818 | 818 | 0 | 0 | FALSE | FALSE | (i.12.a1 - 1) >= -1e-08 |
| V2.7 | 818 | 818 | 0 | 0 | FALSE | FALSE | (i.13.a1 - 1) >= -1e-08 |
| V2.8 | 818 | 818 | 0 | 0 | FALSE | FALSE | (i.16.a1 - 1) >= -1e-08 |
| V2.9 | 818 | 818 | 0 | 0 | FALSE | FALSE | (i.1.h1 - 1) >= -1e-08 |
| V2.10 | 818 | 818 | 0 | 0 | FALSE | FALSE | (i.2.h1 - 1) >= -1e-08 |
| V2.11 | 818 | 818 | 0 | 0 | FALSE | FALSE | (i.5.h1 - 1) >= -1e-08 |
| V2.12 | 818 | 818 | 0 | 0 | FALSE | FALSE | (i.7.h1 - 1) >= -1e-08 |
| V2.13 | 818 | 818 | 0 | 0 | FALSE | FALSE | (i.8.h1 - 1) >= -1e-08 |
| V2.14 | 818 | 818 | 0 | 0 | FALSE | FALSE | (i.10.h1 - 1) >= -1e-08 |
| V2.15 | 818 | 818 | 0 | 0 | FALSE | FALSE | (i.11.h1 - 1) >= -1e-08 |
| V2.16 | 818 | 818 | 0 | 0 | FALSE | FALSE | (i.12.h1 - 1) >= -1e-08 |
| V2.17 | 818 | 818 | 0 | 0 | FALSE | FALSE | (i.14.h1 - 1) >= -1e-08 |
| V3.1 | 818 | 818 | 0 | 0 | FALSE | FALSE | (i.6.a1 - 9) <= 1e-08 |
| V3.2 | 818 | 818 | 0 | 0 | FALSE | FALSE | (i.8.a1 - 9) <= 1e-08 |
| V3.3 | 818 | 818 | 0 | 0 | FALSE | FALSE | (i.9.a1 - 9) <= 1e-08 |
| V3.4 | 818 | 818 | 0 | 0 | FALSE | FALSE | (i.10.a1 - 9) <= 1e-08 |
| V3.5 | 818 | 818 | 0 | 0 | FALSE | FALSE | (i.11.a1 - 9) <= 1e-08 |
| V3.6 | 818 | 818 | 0 | 0 | FALSE | FALSE | (i.12.a1 - 9) <= 1e-08 |
| V3.7 | 818 | 818 | 0 | 0 | FALSE | FALSE | (i.13.a1 - 9) <= 1e-08 |
| V3.8 | 818 | 818 | 0 | 0 | FALSE | FALSE | (i.16.a1 - 9) <= 1e-08 |
| V3.9 | 818 | 818 | 0 | 0 | FALSE | FALSE | (i.1.h1 - 9) <= 1e-08 |
| V3.10 | 818 | 818 | 0 | 0 | FALSE | FALSE | (i.2.h1 - 9) <= 1e-08 |
| V3.11 | 818 | 818 | 0 | 0 | FALSE | FALSE | (i.5.h1 - 9) <= 1e-08 |
| V3.12 | 818 | 818 | 0 | 0 | FALSE | FALSE | (i.7.h1 - 9) <= 1e-08 |
| V3.13 | 818 | 818 | 0 | 0 | FALSE | FALSE | (i.8.h1 - 9) <= 1e-08 |
| V3.14 | 818 | 818 | 0 | 0 | FALSE | FALSE | (i.10.h1 - 9) <= 1e-08 |
| V3.15 | 818 | 818 | 0 | 0 | FALSE | FALSE | (i.11.h1 - 9) <= 1e-08 |
| V3.16 | 818 | 818 | 0 | 0 | FALSE | FALSE | (i.12.h1 - 9) <= 1e-08 |
| V3.17 | 818 | 818 | 0 | 0 | FALSE | FALSE | (i.14.h1 - 9) <= 1e-08 |
| V4.1 | 818 | 818 | 0 | 0 | FALSE | FALSE | i.6.a1 != 6 |
| V4.2 | 818 | 818 | 0 | 0 | FALSE | FALSE | i.8.a1 != 6 |
| V4.3 | 818 | 818 | 0 | 0 | FALSE | FALSE | i.9.a1 != 6 |
| V4.4 | 818 | 818 | 0 | 0 | FALSE | FALSE | i.10.a1 != 6 |
| V4.5 | 818 | 818 | 0 | 0 | FALSE | FALSE | i.11.a1 != 6 |
| V4.6 | 818 | 818 | 0 | 0 | FALSE | FALSE | i.12.a1 != 6 |
| V4.7 | 818 | 818 | 0 | 0 | FALSE | FALSE | i.13.a1 != 6 |
| V4.8 | 818 | 818 | 0 | 0 | FALSE | FALSE | i.16.a1 != 6 |
| V4.9 | 818 | 818 | 0 | 0 | FALSE | FALSE | i.1.h1 != 6 |
| V4.10 | 818 | 818 | 0 | 0 | FALSE | FALSE | i.2.h1 != 6 |
| V4.11 | 818 | 818 | 0 | 0 | FALSE | FALSE | i.5.h1 != 6 |
| V4.12 | 818 | 818 | 0 | 0 | FALSE | FALSE | i.7.h1 != 6 |
| V4.13 | 818 | 818 | 0 | 0 | FALSE | FALSE | i.8.h1 != 6 |
| V4.14 | 818 | 818 | 0 | 0 | FALSE | FALSE | i.10.h1 != 6 |
| V4.15 | 818 | 818 | 0 | 0 | FALSE | FALSE | i.11.h1 != 6 |
| V4.16 | 818 | 818 | 0 | 0 | FALSE | FALSE | i.12.h1 != 6 |
| V4.17 | 818 | 818 | 0 | 0 | FALSE | FALSE | i.14.h1 != 6 |
| V5.1 | 818 | 818 | 0 | 0 | FALSE | FALSE | i.6.a1 != 7 |
| V5.2 | 818 | 818 | 0 | 0 | FALSE | FALSE | i.8.a1 != 7 |
| V5.3 | 818 | 818 | 0 | 0 | FALSE | FALSE | i.9.a1 != 7 |
| V5.4 | 818 | 818 | 0 | 0 | FALSE | FALSE | i.10.a1 != 7 |
| V5.5 | 818 | 818 | 0 | 0 | FALSE | FALSE | i.11.a1 != 7 |
| V5.6 | 818 | 818 | 0 | 0 | FALSE | FALSE | i.12.a1 != 7 |
| V5.7 | 818 | 818 | 0 | 0 | FALSE | FALSE | i.13.a1 != 7 |
| V5.8 | 818 | 818 | 0 | 0 | FALSE | FALSE | i.16.a1 != 7 |
| V5.9 | 818 | 818 | 0 | 0 | FALSE | FALSE | i.1.h1 != 7 |
| V5.10 | 818 | 818 | 0 | 0 | FALSE | FALSE | i.2.h1 != 7 |
| V5.11 | 818 | 818 | 0 | 0 | FALSE | FALSE | i.5.h1 != 7 |
| V5.12 | 818 | 818 | 0 | 0 | FALSE | FALSE | i.7.h1 != 7 |
| V5.13 | 818 | 818 | 0 | 0 | FALSE | FALSE | i.8.h1 != 7 |
| V5.14 | 818 | 818 | 0 | 0 | FALSE | FALSE | i.10.h1 != 7 |
| V5.15 | 818 | 818 | 0 | 0 | FALSE | FALSE | i.11.h1 != 7 |
| V5.16 | 818 | 818 | 0 | 0 | FALSE | FALSE | i.12.h1 != 7 |
| V5.17 | 818 | 818 | 0 | 0 | FALSE | FALSE | i.14.h1 != 7 |
Existen 0 variables de actitudes sobre justicia fuera de rango.
Para validar los datos consideramos los siguientes criterios:
epsoc$duration <- chron(times=epsoc$duration)
## Warning in convert.times(times., fmt): NAs introduced by coercion
## Warning in convert.times(times., fmt): time-of-day entries out of range in
## positions NA,NA,NA,NA,NA,NA,NA,NA,NA,NA set to NA
cf <- check_that(epsoc, edad.seleccionado <= 59 & edad.seleccionado >= 18,
sexo.enc == sexo.seleccionado)
s.cf <- summary(cf)
knitr::kable(s.cf) %>%
kable_estilo()
| name | items | passes | fails | nNA | error | warning | expression |
|---|---|---|---|---|---|---|---|
| V1 | 818 | 815 | 0 | 3 | FALSE | FALSE | edad.seleccionado <= 59 & edad.seleccionado >= 18 |
| V2 | 818 | 804 | 11 | 3 | FALSE | FALSE | abs(sexo.enc - sexo.seleccionado) < 1e-08 |
Resultados:
sexo.enc y sexo.seleccionado.## Fecha de nacimiento y edad seleccionado
epsoc$enc.edad[as.character(epsoc$enc.edad) == "1582-10-14"] <- NA # comportamiento extraño al importar desde SPSS
edad <- tibble(Folio = epsoc$folio[is.na(epsoc$enc.edad)],
Fecha = epsoc$enc.edad[is.na(epsoc$enc.edad)],
Edad = epsoc$edad.seleccionado[is.na(epsoc$enc.edad)])
knitr::kable(edad,
caption = "Casos sin fecha de nacimiento en `enc_edad`",
col.names = c("Folio", "Fecha nacimiento", "Edad")) %>%
kable_estilo()
| Folio | Fecha nacimiento | Edad |
|---|---|---|
| 201350 | NA | 56 |
| 201467 | NA | 59 |
| 202457 | NA | 18 |
| 202580 | NA | 59 |
| 203182 | NA | 39 |
| 203273 | NA | 59 |
| 203315 | NA | 52 |
| 205237 | NA | 59 |
| 900134 | NA | 59 |
| 900753 | NA | 53 |
| 900779 | NA | 59 |
| 901918 | NA | 25 |
| 902320 | NA | 59 |
| 902338 | NA | 56 |
| 902361 | NA | 59 |
| 902379 | NA | 59 |
| 902510 | NA | 59 |
| 902924 | NA | 59 |
| 905422 | NA | 59 |
| 905448 | NA | 59 |
| 905471 | NA | 51 |
| 905877 | NA | 20 |
| 905976 | NA | 59 |
| 1302538 | NA | 47 |
| 1303577 | NA | 39 |
| 1309913 | NA | 49 |
| 1310119 | NA | 39 |
| 1310143 | NA | 26 |
| 1310150 | NA | 55 |
| 1311935 | NA | 24 |
| 1312438 | NA | 48 |
epsoc %>%
filter(sexo.enc != sexo.seleccionado) %>%
select(Folio = folio, sexo.enc, sexo.seleccionado) %>%
knitr::kable(col.names = c("Folio", "sexo.enc", "sexo.seleccionado"),
caption = "Entrevistas donde sexo encuestado y seleccionado no coinciden") %>%
kable_estilo()
| Folio | sexo.enc | sexo.seleccionado |
|---|---|---|
| 200444 | 1 | 2 |
| 201483 | 1 | 2 |
| 205237 | 2 | 1 |
| 902213 | 1 | 2 |
| 1301928 | 2 | 1 |
| 1301936 | 2 | 1 |
| 1301944 | 2 | 1 |
| 1301969 | 1 | 2 |
| 1305911 | 2 | 1 |
| 1307131 | 2 | 1 |
| 1309913 | 1 | 2 |
frq(epsoc$f22)
##
## # ¿Tiene usted hijos o hijas? ¿Cuántos/as? (x) <numeric>
## # total N=818 valid N=818 mean=2.69 sd=1.49
##
## val label frq raw.prc valid.prc cum.prc
## 1 No, ninguno 221 27.02 27.02 27.02
## 2 Uno/a 174 21.27 21.27 48.29
## 3 Dos 198 24.21 24.21 72.49
## 4 Tres 140 17.11 17.11 89.61
## 5 Cuatro 54 6.60 6.60 96.21
## 6 Cinco 12 1.47 1.47 97.68
## 7 Seis o más 16 1.96 1.96 99.63
## 8 No sabe [No leer] 0 0.00 0.00 99.63
## 9 No responde [No leer] 3 0.37 0.37 100.00
## NA NA 0 0.00 NA NA
hijos <- epsoc %>%
select(folio, f22:f26.o5) %>%
mutate(hijo_n = ifelse(f22 <= 7, f22 - 1, NA),
hijo_estudia = ifelse(f23 <= 7, f23 - 1, NA),
hijo_egreso = ifelse(f25 <= 7, f25 - 1, NA),
hijo_suma = hijo_estudia + hijo_egreso) %>%
filter(hijo_n < hijo_suma)
hijos %>%
select(folio, starts_with('hijo')) %>%
arrange(desc(abs(hijo_n - hijo_suma)))
## # A tibble: 16 x 5
## folio hijo_n hijo_estudia hijo_egreso hijo_suma
## <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 200212 4 4 4 8
## 2 207449 4 4 4 8
## 3 203091 6 4 5 9
## 4 203380 2 2 2 4
## 5 1307057 3 3 2 5
## 6 200139 6 4 3 7
## 7 201541 1 1 1 2
## 8 201665 3 2 2 4
## 9 201715 1 2 0 2
## 10 202465 6 1 6 7
## 11 202572 3 4 0 4
## 12 207456 6 5 2 7
## 13 902221 1 1 1 2
## 14 1301753 2 2 1 3
## 15 1302066 3 3 1 4
## 16 1304765 2 2 1 3
Grabar base de datos con variables de viñetas reconstruidas.
epsoc %>%
mutate_if(is.numeric, as_labelled) %>%
haven::write_sav("../EPSOC Base parcial con vinetas.sav")
Obtención de archivos de grabaciones de cada encuesta.
path_general <- '../SurveyToGo Attachments/EPSOC 2018/'
archivos <- dir(path = path_general,
pattern = str_c(epsoc$sbj.num, collapse = '|'),
recursive = TRUE)
file.copy(from = str_c(path_general, archivos),
to = "grabaciones/",
overwrite = TRUE)